home *** CD-ROM | disk | FTP | other *** search
/ F1 Licenseware / F1 Licenseware - Volume 1.iso / disks / 050a.dms / 050a.adf / EXAMPLE_PROGRAMS / example24.AMOS / example24.amosSourceCode
AMOS Source Code  |  1992-02-26  |  7KB  |  268 lines
  1. '
  2. '     THE AMOSZINE CLASSIC PROCEDURES LIBRARY  
  3. '     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 
  4. '  
  5. '     PROC NO. : 2 
  6. '
  7. '     PROC NAME: NEW RGB REQUESTOR   
  8. '
  9. '     ORIGIN   : AMINET CD   
  10. '
  11. '     AUTHOR   : Rob Farnsworth      
  12. '
  13. '     PURPOSE  : Dpaint 3 style palette requestor  
  14. '
  15. '     PARAMS   : See authors comment 
  16. '
  17. '       COMMENT: This routine is old, but what a cracker!
  18. '                I like the fact that you can drag the req 
  19. '                around the screen and it gives the hex$ for 
  20. '                the colour you are editing. Useful in development 
  21. '                as well as in a program, esp a util.
  22. '                  
  23. '======================================================
  24.  
  25. ' Robert Farnsworth
  26. ' 1 Vidovic Ave, Mildura, 3500 
  27. '
  28. ' Comment from author: 
  29. '--------------------
  30. ' This palette changer routine originaly came from the Sprite Editor.  
  31. ' I have modified it so that it can be placed anywhere on the screen by
  32. ' supplying the XY coords of the top left corner.  It will auto-centre 
  33. ' on either axis if set to zero - set both to zero and the requester 
  34. ' is placed in the middle of the screen. 
  35. ' Another addition is a drag bar, at the top, that allows the requester
  36. ' to be moved. 
  37. ' Works in Lowres and Hires. 
  38. '
  39. ' Unfold CHANGERGB for parameter info. 
  40. '----------------------------------------------------------------------- 
  41. '
  42. 'A WORKING EXAMPLE 
  43. '
  44.  
  45. Screen Open 0,640,256,16,Hires
  46. Curs Off : Flash Off : Cls 0
  47. Reserve Zone 40
  48. '
  49. For I=0 To Screen Colour-1
  50.    Paper I
  51.    Print At(0,I);Space$(80)
  52. Next 
  53. '
  54.  
  55.  
  56. CHANGERGB[0,0,0,2,4]
  57.  
  58.  
  59.  
  60. '
  61. '--------------- Colour changer routines --------------
  62. '
  63. Procedure CHANGERGB[X,Y,SCRN,C1,C2]
  64.    '  
  65.    ' Palette changer. 
  66.    '  
  67.    ' X,Y   - Coords of top left corner. (Will auto centre 
  68.    '         if coord is zero)
  69.    ' SCRN  - The screen to put requester on.  
  70.    ' C1,C2 - C1 - Body colour, C2 - The other colour. 
  71.    '
  72.    Shared X1,Y1,X2,Y2,YO,OK,CANCEL,DRAG
  73.    Dim RGB(31)
  74.    '
  75.    SC=Screen
  76.    Screen SCRN
  77.    Set Font 0 : Rem Select default font
  78.    Reset Zone 
  79.    Reserve Zone Screen Colour+6
  80.    ' ---  
  81.    W=204 : H=103 : NCOLS=Screen Colour
  82.    ' --- Centre requester if X or Y are zero
  83.    If X=0 Then X=Screen Width/2-W/2
  84.    If Y=0 Then Y=Screen Height/2-H/2
  85.    RGBINIT[X,Y,W,H,NCOLS]
  86.    Get Block 1,X1,Y1-YO,W+4,H+4+YO
  87.    ' --- Draw the requester --- 
  88.    Ink 0,0
  89.    Bar X1+3,Y1+3-YO To X1+W+3,Y1+H+3
  90.    Ink C1,C2
  91.    Bar X1,Y1-YO To X2,Y2
  92.    Ink C2,C1
  93.    Box X1+1,Y1+1-YO To X2-1,Y2-1
  94.    Ink C2,C1
  95.    ' --- slider bars
  96.    For A=0 To 2
  97.       Bar X1+7+A*20,Y1+3 To X1+23+A*20,Y2-3
  98.    Next 
  99.    ' --- Tic marks
  100.    For A=0 To 16
  101.       Draw X1+4,Y1+3+A*6 To X1+66,Y1+3+A*6
  102.    Next 
  103.    ' ---  palette 
  104.    For A=0 To Min(32,NCOLS)-1
  105.       Ink A,A : XX=A mod 8 : YY=A/8
  106.       Bar X1+XX*16+72,Y1+YY*16+4 To X1+XX*16+87,Y1+YY*16+20
  107.       RGB(A)=Colour(A)
  108.    Next 
  109.    Ink C2,C1
  110.    Box X1+71,Y1+3 To X1+88+16*XX,Y1+21+16*YY
  111.    ' --- OK CANCEL buttons
  112.    Box X1+72,Y1+87 To X1+132,Y1+97
  113.    Text X1+78,Y1+95,"Cancel"
  114.    Box X1+144,Y1+87 To X1+194,Y1+97
  115.    Text X1+157,Y1+95,"O.K"
  116.    '--- Selected colour 
  117.    SELCOL=0 : Rem default to colour 0
  118.    Ink SELCOL
  119.    Bar X1+187,Y1+75 To X1+193,Y1+84
  120.    Ink C2
  121.    Box X1+186,Y1+74 To X1+194,Y1+85
  122.    ' --- Drag bar 
  123.    Ink C2
  124.    Bar X1+4,Y1-YO+4 To X2-4,Y1
  125.    '------------------------------------------
  126.    ' --- draw RGB buttons 
  127.    SFADERS[SELCOL,X1,Y1,C1,C2]
  128.    ' --- main loop
  129.    CHANGING_COLOURS=True
  130.    While CHANGING_COLOURS
  131.       While Mouse Key=0 : Wend 
  132.       YM=Y Screen(Y Mouse)-Y1+3 : Z=Mouse Zone
  133.       If Z>0 and Z<4
  134.          ' --- sliders moving 
  135.          CFADERS[SELCOL,Z-1,YM]
  136.          SFADERS[SELCOL,X1,Y1,C1,C2]
  137.       End If 
  138.       If Z>3 and Z<3+NCOLS+1
  139.          ' --- colour selected
  140.          SELCOL=Z-4
  141.          Ink SELCOL
  142.          Bar X1+187,Y1+75 To X1+193,Y1+84
  143.          SFADERS[SELCOL,X1,Y1,C1,C2]
  144.          Ink SELCOL
  145.       End If 
  146.       If Z=CANCEL
  147.          ' --- Cancel 
  148.          CHANGING_COLOURS=False
  149.       End If 
  150.       If Z=OK
  151.          ' --- Ok 
  152.          A=0
  153.          Repeat 
  154.             Colour A,RGB(A) : SPCOL[A,RGB(A)]
  155.             Inc A
  156.          Until A>=Min(32,NCOLS)
  157.          CHANGING_COLOURS=False
  158.       End If 
  159.       If Z=DRAG
  160.          ' --- Drag bar 
  161.          WIDTH=W+4 : HEIGHT=H+3+YO
  162.          ' --- Get req image
  163.          Get Block 2,X1,Y1-YO,WIDTH,HEIGHT+1
  164.          MX=X Screen(X Mouse) : MY=Y Screen(Y Mouse)
  165.          MXO=MX-X1 : MYO=MY-Y1+YO
  166.          Gr Writing 2 : Rem XOR
  167.          Limit Mouse X Hard(MXO),Y Hard(MYO) To X Hard(Screen Width-(WIDTH-MXO)),Y Hard(Screen Height-(HEIGHT-MYO)-1)
  168.          While Mouse Key=1
  169.             Box MX-MXO,MY-MYO To MX-MXO+WIDTH,MY-MYO+HEIGHT
  170.             OLDX=MX : OLDY=MY
  171.             While OLDX=X Screen(X Mouse) and OLDY=Y Screen(Y Mouse) : Wend 
  172.             MX=X Screen(X Mouse) : MY=Y Screen(Y Mouse)
  173.             Box OLDX-MXO,OLDY-MYO To OLDX-MXO+WIDTH,OLDY-MYO+HEIGHT
  174.          Wend 
  175.          Limit Mouse X Hard(0),Y Hard(0) To X Hard(Screen Width),Y Hard(Screen Height)
  176.          Gr Writing 1
  177.          ' --- Restore bg at old location 
  178.          Put Block 1
  179.          ' --- Save bg at new location
  180.          Get Block 1,MX-MXO,MY-MYO,WIDTH,HEIGHT+1
  181.          ' --- Put Req at new location
  182.          Put Block 2,MX-MXO,MY-MYO
  183.          Del Block 2
  184.          ' --- Re-calc var's & zones ---
  185.          X=MX-MXO : Y=MY-MYO+YO
  186.          RGBINIT[X,Y,W,H,NCOLS]
  187.       End If 
  188.    Wend 
  189.    Put Block 1
  190.    Screen SC
  191.    Del Block 1
  192. End Proc
  193. '
  194. Procedure RGBINIT[X,Y,W,H,NCOLS]
  195.    ' Calc main vbls & set zones.
  196.    ' Has to be done twice, hence the proc.
  197.    Shared X1,Y1,X2,Y2,YO,OK,CANCEL,DRAG
  198.    X1=X : X2=X1+W : Y1=Y : Y2=Y1+H : YO=6
  199.    Z=1
  200.    For A=0 To 2
  201.       Set Zone Z,X1+7+A*20,Y1+3 To X1+23+A*20,Y2-3 : Inc Z
  202.    Next 
  203.    For A=0 To Min(32,NCOLS)-1
  204.       Ink A,A : XX=A mod 8 : YY=A/8
  205.       Set Zone Z,X1+XX*16+72,Y1+YY*16+4 To X1+XX*16+87,Y1+YY*16+20 : Inc Z
  206.    Next 
  207.    Set Zone Z,X1+72,Y1+87 To X1+132,Y1+97 : OK=Z : Inc Z
  208.    Set Zone Z,X1+146,Y1+87 To X1+194,Y1+97 : CANCEL=Z : Inc Z
  209.    Set Zone Z,X1+4,Y1-YO+4 To X2-4,Y1 : DRAG=Z
  210. End Proc
  211. '
  212. Procedure CFADERS[S,F,YM]
  213.    Dim R(2)
  214.    ' --- get RGB components of selected colour
  215.    C=Colour(S)
  216.    R(0)=C/256
  217.    R(1)=(C/16) mod 16
  218.    R(2)=C mod 16
  219.    ' --- amplitude of slider (0..15)
  220.    V=Max(0,Min(15,15-(YM-7)/6))
  221.    ' --- set RGB's value
  222.    R(F)=V
  223.    ' --- set selected colour
  224.    Colour S,(R(0)*256+R(1)*16+R(2))
  225.    ' ---  
  226.    SPCOL[S,Colour(S)]
  227. End Proc
  228. '
  229. Procedure SFADERS[S,X1,Y1,C1,C2]
  230.    Shared RGBO
  231.    Dim R(2)
  232.    '
  233.    C=RGBO
  234.    R(0)=C/256
  235.    R(1)=(C/16) mod 16
  236.    R(2)=C mod 16
  237.    ' --- Erase slider button
  238.    Ink C2,C2
  239.    For A=0 To 2
  240.       V=(15-R(A))*6+4
  241.       Bar X1+9+20*A,Y1+V To X1+20+20*A,Y1+V+5
  242.    Next 
  243.    ' --- set new colour value 
  244.    C=Colour(S)
  245.    RGBO=C
  246.    R(0)=C/256
  247.    R(1)=(C/16) mod 16
  248.    R(2)=C mod 16
  249.    ' --- print the colour value in hex
  250.    Ink C2,C1
  251.    Gr Writing 1
  252.    Text X1+72,Y1+82,"Col"+Right$(" "+Str$(S),2)+" Val:$"+Right$("000"+Mid$(Hex$(RGBO),2),3)
  253.    Ink C1,C1
  254.    ' --- draw new slider button 
  255.    For A=0 To 2
  256.       Ink C1,C1
  257.       V=(15-R(A))*6+4
  258.       Box X1+9+20*A,Y1+V To X1+20+20*A,Y1+V+5
  259.       Ink S
  260.       Bar X1+10+20*A,Y1+V+1 To X1+19+20*A,Y1+V+4
  261.    Next 
  262. End Proc
  263. '
  264. Procedure SPCOL[A,B]
  265.    If Length(1)>0
  266.       Doke Start(1)+2+8*Length(1)+2*A,B
  267.    End If 
  268. End Proc